home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 34.zip / BS1 part 34 / GFA basic training.adf / Grafik / 3.1.LST < prev    next >
File List  |  1989-06-01  |  19KB  |  696 lines
  1. ' 3.1
  2. '
  3. @main
  4. '
  5. > PROCEDURE main
  6.   DIM daten(53,5,3),darstellung$(6)
  7.   OPEN "i",#1,"Dow_Jones"
  8.   FOR i|=1 TO 53
  9.     FOR j|=1 TO 5
  10.       FOR k|=1 TO 3
  11.         INPUT #1,daten(i|,j|,k|)
  12.       NEXT k|
  13.     NEXT j|
  14.   NEXT i|
  15.   CLOSE #1
  16.   '
  17.   RESTORE art
  18.   FOR i|=1 TO 6
  19.     READ darstellung$(i|)
  20.   NEXT i|
  21.   '
  22.   REPEAT
  23.     @auswahl_box(1,6,darstellung$(),art!())
  24.     i|=1
  25.     WHILE art!(i|)
  26.       INC i|
  27.     WEND
  28.     ERASE art!()
  29.     @daten(i|)
  30.   UNTIL i|=6
  31.   '
  32.   art:
  33.   DATA Matrix,Rollbalken,Histogramm,Kurve,Kuchen,Ende
  34. RETURN
  35. > PROCEDURE daten(art|)
  36.   SELECT art|
  37.   CASE 1 ! Matrix
  38.     '
  39.     DIM matrix(31,12)
  40.     RESTORE tage
  41.     woche|=1
  42.     wochentag|=4
  43.     FOR monat|=1 TO 12
  44.       READ tage|
  45.       FOR tag|=1 TO tage|
  46.         '
  47.         IF wochenend|=0
  48.           matrix(tag|,monat|)=daten(woche|,wochentag|,3)
  49.           INC wochentag|
  50.           IF wochentag|=6
  51.             wochenend|=2
  52.             wochentag|=1
  53.             INC woche|
  54.           ENDIF
  55.         ELSE IF wochenend|>0
  56.           DEC wochenend|
  57.         ENDIF
  58.         '
  59.       NEXT tag|
  60.     NEXT monat|
  61.     @matrix(31,12,4,2,10,"Dow Jones Schlußkurse 1987",matrix())
  62.     ERASE matrix()
  63.     tage:
  64.     DATA 31,28,31,30,31,30,31,31,30,31,30,31
  65.     '
  66.   CASE 2 ! Rollbalken
  67.     '
  68.     DIM roll$(53*5)
  69.     FOR i|=1 TO 53
  70.       FOR j|=1 TO 5
  71.         roll$(PRED(i|)*5+j|)="  "
  72.         RSET roll$(PRED(i|)*5+j|)=STR$(i|)
  73.         roll$(PRED(i|)*5+j|)=roll$(PRED(i|)*5+j|)+" "+STR$(j|)
  74.         FOR k|=1 TO 3
  75.           roll$(PRED(i|)*5+j|)=roll$(PRED(i|)*5+j|)+STR$(daten(i|,j|,k|),10,2)
  76.         NEXT k|
  77.       NEXT j|
  78.     NEXT i|
  79.     @roll(1,53*5,20,LEN(roll$(1))*8,"1987   High      Low       Close   ",roll$)
  80.     ERASE roll$()
  81.     '
  82.   CASE 3 ! Histo
  83.     '
  84.     DIM histo(53)
  85.     FOR i|=1 TO 53
  86.       summe=0
  87.       FOR j|=1 TO 5
  88.         ADD summe,daten(i|,j|,3)
  89.       NEXT j|
  90.       histo(i|)=summe/5
  91.     NEXT i|
  92.     @histo(1,53,"Dow Jones, Wochenmittel 1987",histo())
  93.     ERASE histo()
  94.     '
  95.   CASE 4 ! Kurve
  96.     '
  97.     DIM kurve(53*5)
  98.     FOR i|=1 TO 53
  99.       FOR j|=1 TO 5
  100.         kurve(PRED(i|)*5+j|)=daten(i|,j|,3)
  101.       NEXT j|
  102.     NEXT i|
  103.     @kurve(1,53*5,"Dow Jones Industrial Index, 1987",kurve())
  104.     ERASE kurve()
  105.     '
  106.   CASE 5 ! Kuchen
  107.     '
  108.     DIM kuchen(4),kuchen$(5)
  109.     RESTORE kuchen
  110.     RANDOMIZE
  111.     FOR i|=1 TO 4
  112.       kuchen(i|)=SUCC(RAND(5))
  113.       READ kuchen$(i|)
  114.     NEXT i|
  115.     READ kuchen$(i|)
  116.     @kuchen(1,4,kuchen$(),kuchen())
  117.     ERASE kuchen$(),kuchen()
  118.     '
  119.     kuchen:
  120.     DATA Titel für Kuchen-Diagramm,Eins,Zwei,Drei,Vier
  121.   ENDSELECT
  122. RETURN
  123. '
  124. PROCEDURE matrix(z&,s&,vk|,nk|,zeilen|,titel$,VAR matrix())
  125.   '
  126.   spalte|=SUCC(vk|+nk|)*8+6
  127.   n_spalten|=MIN(INT(580/spalte|),s&)
  128.   links|=24+4
  129.   rechts|=16
  130.   oben|=24
  131.   unten|=9
  132.   b_breite&=links|+n_spalten|*spalte|+rechts|
  133.   b_hÖhe&=oben|+zeilen|*9+unten|
  134.   x1&=310-b_breite&/2
  135.   y1&=118-b_hÖhe&/2
  136.   x2&=310+b_breite&/2
  137.   y2&=118+b_hÖhe&/2
  138.   '
  139.   GET x1&,y1&,x2&,y2&,hintergrund$
  140.   COLOR 0
  141.   PBOX x1&,y1&,x2&,y2&
  142.   COLOR 1
  143.   BOX x1&,y1&,x2&,y2&
  144.   '
  145.   ' Titel
  146.   BOX x1&,y1&,x2&,y1&+12
  147.   TEXT x1&+b_breite&/2-LEN(titel$)*4,y1&+9,titel$
  148.   '
  149.   ' LINKS
  150.   BOX x1&,y1&+oben|,x1&+links|,y2&-unten|
  151.   spalte$="   "
  152.   FOR i|=1 TO zeilen|
  153.     RSET spalte$=STR$(i|)
  154.     TEXT x1&+2,y1&+oben|-2+i|*9,spalte$
  155.   NEXT i|
  156.   '
  157.   ' RECHTS
  158.   drittel&=((y2&-unten|)-(y1&+oben|))/3
  159.   ou1&=x2&-rechts|
  160.   ou2&=x2&
  161.   oben1&=y1&+oben|
  162.   oben2&=y1&+oben|+drittel&
  163.   BOX ou1&,oben1&,ou2&,oben2&
  164.   unten1&=y2&-unten|-drittel&
  165.   unten2&=y2&-unten|
  166.   BOX ou1&,unten1&,ou2&,unten2&
  167.   py1|=unten1&+drittel&/3
  168.   py2|=unten2&-drittel&/3
  169.   LINE ou1&+rechts|/2,py1|,ou1&+rechts|/2,py2|
  170.   LINE SUCC(ou1&),py2|-4,ou1&+rechts|/2,py2|
  171.   LINE ou1&+rechts|/2,py2|,PRED(ou2&),py2|-4
  172.   '
  173.   BOX ou1&,oben2&,ou2&,unten1&
  174.   py1|=oben1&+drittel&/3
  175.   py2|=oben2&-drittel&/3
  176.   LINE ou1&+rechts|/2,py1|,ou1&+rechts|/2,py2|
  177.   LINE SUCC(ou1&),py1|+4,ou1&+rechts|/2,py1|
  178.   LINE ou1&+rechts|/2,py1|,PRED(ou2&),py1|+4
  179.   '
  180.   ' OBEN
  181.   BOX x1&+links|,y1&+12,x2&-rechts|,y1&+oben|
  182.   spalte$="   "
  183.   FOR i|=1 TO n_spalten|
  184.     RSET spalte$=STR$(i|)
  185.     TEXT x1&+links|-27+i|*spalte|,y1&+21,spalte$
  186.     LINE x1&+links|+i|*spalte|,y1&+12,x1&+links|+i|*spalte|,y1&+oben|
  187.   NEXT i|
  188.   '
  189.   ' UNTEN
  190.   drittel&=((x2&-rechts|)-(x1&+links|))/3
  191.   links1&=x1&+links|
  192.   links2&=x1&+links|+drittel&
  193.   rl1&=y2&-unten|
  194.   rl2&=y2&
  195.   BOX links1&,rl1&,links2&,rl2&
  196.   px1&=links1&+drittel&/3
  197.   px2&=links2&-drittel&/3
  198.   LINE px1&,rl1&+unten|/2,px2&,rl1&+unten|/2
  199.   LINE px1&+6,rl1&+unten|/2-4,px1&,rl1&+unten|/2
  200.   LINE px1&+6,rl1&+unten|/2+4,px1&,rl1&+unten|/2
  201.   rechts1&=x2&-rechts|-drittel&
  202.   rechts2&=x2&-rechts|
  203.   BOX rechts1&,rl1&,rechts2&,rl2&
  204.   px1&=rechts1&+drittel&/3
  205.   px2&=rechts2&-drittel&/3
  206.   LINE px1&,rl1&+unten|/2,px2&,rl1&+unten|/2
  207.   LINE px2&-6,rl1&+unten|/2-4,px2&,rl1&+unten|/2
  208.   LINE px2&-6,rl1&+unten|/2+4,px2&,rl1&+unten|/2
  209.   BOX links2&,rl1&,rechts1&,rl2&
  210.   '
  211.   ' TEXT
  212.   FOR i|=1 TO zeilen|
  213.     ty&=y1&+oben|-2+i|*9
  214.     FOR j|=1 TO n_spalten|
  215.       tx&=x1&+links|-SUCC(vk|+nk|)*8+j|*spalte|
  216.       TEXT tx&,ty&,STR$(matrix(i|,j|),SUCC(vk|+nk|),nk|)
  217.     NEXT j|
  218.   NEXT i|
  219.   l_neu&=SUCC(n_spalten|)
  220.   r_neu&=0
  221.   o_neu&=SUCC(zeilen|)
  222.   u_neu&=0
  223.   '
  224.   REPEAT
  225.     IF MOUSEK=1
  226.       IF MOUSEY>rl1& AND MOUSEY<rl2&
  227.         IF MOUSEX>links1& AND MOUSEX<links2&
  228.           IF l_neu&<=s&  !Links
  229.             SCROLL -spalte|,0,SUCC(x1&+links|),SUCC(y1&+12),PRED(x2&-rechts|),PRED(y2&-unten|)
  230.             tx&=x2&-rechts|-spalte|+6
  231.             ty&=y1&+oben|+7
  232.             FOR j|=SUCC(u_neu&) TO u_neu&+zeilen|
  233.               TEXT tx&,ty&,STR$(matrix(j|,l_neu&),SUCC(vk|+nk|),nk|)
  234.               ADD ty&,9
  235.             NEXT j|
  236.             RSET spalte$=STR$(l_neu&)
  237.             TEXT x1&+links|-27+n_spalten|*spalte|,y1&+21,spalte$
  238.             LINE x2&-rechts|-spalte|,y1&+12,x2&-rechts|-spalte|,y1&+oben|
  239.             LINE x2&-rechts|-spalte|,y1&+oben|,x2&-rechts|,y1&+oben|
  240.             INC l_neu&
  241.             INC r_neu&
  242.           ENDIF
  243.         ELSE IF MOUSEX>rechts1& AND MOUSEX<rechts2&
  244.           IF r_neu&  !Rechts
  245.             SCROLL spalte|,0,SUCC(x1&+links|),SUCC(y1&+12),PRED(x2&-rechts|),PRED(y2&-unten|)
  246.             tx&=x1&+links|+6
  247.             ty&=y1&+oben|+7
  248.             FOR j|=SUCC(u_neu&) TO u_neu&+zeilen|
  249.               TEXT tx&,ty&,STR$(matrix(j|,r_neu&),SUCC(vk|+nk|),nk|)
  250.               ADD ty&,9
  251.             NEXT j|
  252.             RSET spalte$=STR$(r_neu&)
  253.             TEXT x1&+links|-27+spalte|,y1&+21,spalte$
  254.             LINE x1&+links|+spalte|,y1&+12,x1&+links|+spalte|,y1&+oben|
  255.             LINE x1&+links|,y1&+oben|,x1&+links|+spalte|,y1&+oben|
  256.             DEC r_neu&
  257.             DEC l_neu&
  258.           ENDIF
  259.         ENDIF
  260.       ENDIF
  261.       '
  262.       IF MOUSEX>ou1& AND MOUSEX<ou2&
  263.         IF MOUSEY>oben1& AND MOUSEY<oben2&
  264.           IF o_neu&<=z&  !Hoch
  265.             SCROLL 0,-9,SUCC(x1&),SUCC(y1&+oben|),PRED(x2&-rechts|),PRED(y2&-unten|)
  266.             ty&=y2&-unten|-2
  267.             tx&=x1&+links|-SUCC(vk|+nk|)*8+spalte|
  268.             FOR i|=SUCC(r_neu&) TO r_neu&+n_spalten|
  269.               TEXT tx&,ty&,STR$(matrix(o_neu&,i|),SUCC(vk|+nk|),nk|)
  270.               ADD tx&,spalte|
  271.             NEXT i|
  272.             RSET spalte$=STR$(o_neu&)
  273.             TEXT x1&+2,y1&+oben|-2+zeilen|*9,spalte$
  274.             LINE x1&+links|,y2&-unten|-12,x1&+links|,y2&-unten|
  275.             INC o_neu&
  276.             INC u_neu&
  277.           ENDIF
  278.         ELSE IF MOUSEY>unten1& AND MOUSEY<unten2&
  279.           IF u_neu&
  280.             SCROLL 0,9,SUCC(x1&),SUCC(y1&+oben|),PRED(x2&-rechts|),PRED(y2&-unten|)
  281.             ty&=y1&+oben|+9-2
  282.             tx&=x1&+links|-SUCC(vk|+nk|)*8+spalte|
  283.             FOR i|=SUCC(r_neu&) TO r_neu&+n_spalten|
  284.               TEXT tx&,ty&,STR$(matrix(u_neu&,i|),SUCC(vk|+nk|),nk|)
  285.               ADD tx&,spalte|
  286.             NEXT i|
  287.             RSET spalte$=STR$(u_neu&)
  288.             TEXT x1&+2,y1&+oben|+7,spalte$
  289.             LINE x1&+links|,y1&+oben|,x1&+links|,y1&+oben|+12
  290.             DEC u_neu&
  291.             DEC o_neu&
  292.           ENDIF
  293.         ENDIF
  294.       ENDIF
  295.     ENDIF
  296.     '
  297.   UNTIL MOUSEX>x1& AND MOUSEX<x1&+links| AND MOUSEY>y1& AND MOUSEY<y1&+oben| AND MOUSEK=1
  298.   PUT x1&,y1&,hintergrund$
  299. RETURN
  300. > PROCEDURE roll(von&,bis&,zeilen&,breite&,titel$,VAR roll$)
  301.   '
  302.   COLOR 1
  303.   roll_menge&=SUCC(bis&-von&)
  304.   text_z&=8
  305.   pixel&=zeilen&*text_z&
  306.   anteil&=MIN(1,(zeilen&/roll_menge&))*pixel&-2
  307.   scroll_zeilen&=roll_menge&-zeilen&
  308.   scroll_pixel&=pixel&-2-anteil&
  309.   scroll_zeile=scroll_pixel&/scroll_zeilen&
  310.   '
  311.   ADD breite&,16
  312.   x_l_ausschnitt&=320-breite&/2
  313.   x_r_ausschnitt&=x_l_ausschnitt&+breite&
  314.   x_l_roll&=x_r_ausschnitt&
  315.   x_r_roll&=x_l_roll&+16
  316.   y_oben&=110-(pixel&+2)/2+12
  317.   y_unten&=y_oben&+pixel&+2
  318.   text_x&=x_l_ausschnitt&+3
  319.   text_y&=y_oben&+text_z&
  320.   '
  321.   GET x_l_ausschnitt&,y_oben&-12,x_r_ausschnitt&+16,y_unten&,hintergrund$
  322.   COLOR 0
  323.   PBOX x_l_ausschnitt&,y_oben&-12,x_r_ausschnitt&+16,y_unten&
  324.   COLOR 1
  325.   '
  326.   BOX x_l_ausschnitt&,y_oben&-12,x_r_ausschnitt&+16,y_oben&
  327.   TEXT x_l_ausschnitt&+breite&/2-LEN(titel$)*4,y_oben&-3,titel$
  328.   BOX x_l_ausschnitt&,y_oben&,x_r_ausschnitt&,y_unten&
  329.   BOX x_l_roll&,y_oben&,x_r_roll&,y_unten&
  330.   '
  331.   sprite$=""
  332.   FOR i|=0 TO anteil&
  333.     sprite$=sprite$+CHR$(256)+CHR$(0)+CHR$(0)+CHR$(252)
  334.   NEXT i|
  335.   sprite_x&=x_l_roll&-11
  336.   sprite_y=y_oben&+24
  337.   scroll=sprite_y
  338.   SPRITE #2,sprite$
  339.   SPRITE #2,sprite_x&,sprite_y
  340.   '
  341.   FOR i|=von& TO MIN(bis&,von&+PRED(zeilen&))
  342.     TEXT text_x&,text_y&+(i|-von&)*text_z&,roll$(i|)
  343.   NEXT i|
  344.   zeile1&=von&
  345.   '
  346.   IF roll_menge&>zeilen&
  347.     REPEAT
  348.       IF MOUSEX>x_l_roll& AND MOUSEX<x_r_roll& AND MOUSEY+22>=sprite_y AND MOUSEY+22<=sprite_y+anteil&
  349.         position=MOUSEY+22-sprite_y
  350.         WHILE MOUSEK=1
  351.           erster&=von&+INT((sprite_y-scroll)/scroll_zeile)
  352.           sprite_y=MOUSEY+22-position
  353.           '
  354.           IF sprite_y<scroll
  355.             sprite_y=scroll
  356.           ELSE IF sprite_y>scroll+scroll_pixel&
  357.             sprite_y=scroll+scroll_pixel&
  358.           ENDIF
  359.           '
  360.           SPRITE #2,sprite_x&,sprite_y
  361.           '
  362.           IF erster&>zeile1&
  363.             '
  364.             INC zeile1&
  365.             SCROLL 0,-text_z&,SUCC(x_l_ausschnitt&),SUCC(y_oben&),PRED(x_r_ausschnitt&),PRED(y_unten&)
  366.             TEXT text_x&,text_y&+PRED(zeilen&)*text_z&,roll$(zeile1&+PRED(zeilen&))
  367.             '
  368.           ELSE IF erster&<zeile1&
  369.             '
  370.             DEC zeile1&
  371.             SCROLL 0,text_z&,SUCC(x_l_ausschnitt&),SUCC(y_oben&),PRED(x_r_ausschnitt&),PRED(y_unten&)
  372.             TEXT text_x&,text_y&,roll$(zeile1&)
  373.             '
  374.           ENDIF
  375.           '
  376.         WEND
  377.       ENDIF
  378.     UNTIL MOUSEK=2
  379.   ENDIF
  380.   SPRITE #2
  381.   PUT x_l_ausschnitt&,y_oben&-12,hintergrund$
  382. RETURN
  383. '
  384. > PROCEDURE histo(von&,bis&,titel$,VAR daten())
  385.   '
  386.   @parameter
  387.   '
  388.   scale=8/((max-min)/10)
  389.   DRAW "sx0 sy";scale
  390.   DRAW "ma";a_null&+2,o_null&,""
  391.   FOR i|=von& TO bis&
  392.     DRAW "tt 0 fd";daten(i|)-min;"tt 90 fd";breite|-4;"tt 180 fd";daten(i|)-min;"tt 90 fd 4"
  393.   NEXT i|
  394.   @warte
  395.   PUT x%,y&-12,hintergrund$
  396. RETURN
  397. PROCEDURE kurve(von&,bis&,titel$,VAR daten())
  398.   '
  399.   @parameter
  400.   '
  401.   DEFFN kurve(wert)=o_null&-((wert-min)/(max-min))*80
  402.   ADD a_null&,breite|/2
  403.   PLOT a_null&,@kurve(daten(von&))
  404.   INC von&
  405.   ADD a_null&,breite|
  406.   FOR i&=von& TO bis&
  407.     DRAW  TO a_null&,@kurve(daten(i&))
  408.     ADD a_null&,breite|
  409.   NEXT i&
  410.   @warte
  411.   PUT x%,y&-12,hintergrund$
  412.   hintergrund$=""
  413. RETURN
  414. > PROCEDURE kuchen(von&,bis&,VAR k_titel$(),k_daten())
  415.   summe=0
  416.   FOR i&=von& TO bis&
  417.     ADD summe,k_daten(i&)
  418.   NEXT i&
  419.   '
  420.   k_daten(von&)=360*(k_daten(von&)/summe)
  421.   FOR i&=SUCC(von&) TO bis&
  422.     k_daten(i&)=k_daten(PRED(i&))+360*(k_daten(i&)/summe)
  423.   NEXT i&
  424.   '
  425.   GET 60,30,600,200,hintergrund$
  426.   COLOR 0
  427.   PBOX 60,30,600,200
  428.   COLOR 1
  429.   '
  430.   TEXT 320-LEN(kuchen$(1))*4,40,kuchen$(1)
  431.   CIRCLE 320,115,100
  432.   DRAW "sx0 sy.442"
  433.   FOR i&=von& TO bis&
  434.     DRAW "ma 320,115 tt",k_daten(i&),"fd";100
  435.   NEXT i&
  436.   '
  437.   FOR i&=von& TO bis&
  438.     DRAW "ma 320,115 tt",k_daten(i&)/2+k_daten(PRED(i&))/2,"pu"
  439.     DRAW "fd 50"
  440.     DEFFILL 1,3,i&
  441.     FILL DRAW(0),DRAW(1)
  442.     DRAW "fd 50 pd fd 50"
  443.     IF k_daten(i&)/2+k_daten(PRED(i&))/2<=180
  444.       DRAW "tt 90 fd 20"
  445.       TEXT DRAW(0)+3,DRAW(1)+3,k_titel$(SUCC(i&))
  446.     ELSE
  447.       DRAW "tt 270 fd 20"
  448.       TEXT DRAW(0)-LEN(k_titel$(i&))*8,DRAW(1)+3,k_titel$(SUCC(i&))
  449.     ENDIF
  450.   NEXT i&
  451.   @warte
  452.   PUT 60,30,hintergrund$
  453.   hintergrund$=""
  454.   '
  455. RETURN
  456. '
  457. > PROCEDURE warte
  458.   REPEAT
  459.   UNTIL MOUSEK=1 OR INKEY$=CHR$(13) OR INKEY$=CHR$(27)
  460. RETURN
  461. PROCEDURE parameter
  462.   '
  463.   max=0
  464.   min=100000
  465.   FOR i&=von& TO bis&
  466.     max=MAX(max,daten(i&))
  467.     min=MIN(min,daten(i&))
  468.   NEXT i&
  469.   max=SUCC(INT(max/10^PRED(INT(LOG10(max)))))*10^PRED(INT(LOG10(max)))
  470.   min=PRED(INT(min/10^PRED(INT(LOG10(min)))))*10^PRED(INT(LOG10(min)))
  471.   '
  472.   hÖhe&=24+11*8
  473.   schrittweite&=SUCC(bis&-von&)
  474.   breite|=INT(20/SUCC(INT(schrittweite&/25)))
  475.   breite&=MAX(MAX(4,LEN(STR$(max)))*8+13+schrittweite&*breite|,LEN(titel$)*8+10)
  476.   '
  477.   x%=320-breite&/2
  478.   y&=110-hÖhe&/2
  479.   '
  480.   GET x%,y&-12,x%+breite&,y&+hÖhe&,hintergrund$
  481.   COLOR 0
  482.   PBOX x%,y&-12,x%+breite&,y&+hÖhe&-12
  483.   COLOR 1
  484.   '
  485.   BOX x%,y&-12,x%+breite&,y&
  486.   TEXT (x%+breite&/2)-LEN(titel$)*4,y&-3,titel$
  487.   BOX x%,y&,x%+breite&,y&+hÖhe&-12
  488.   ordinate$=SPACE$(MAX(4,LEN(STR$(max))))
  489.   o_null&=y&+85
  490.   a_null&=x%+8+(MAX(4,LEN(STR$(max))))*8
  491.   '
  492.   LINE a_null&,y&+4,a_null&,y&+90
  493.   IF max<12
  494.     z|=4
  495.     d|=1
  496.   ELSE
  497.     z|=LEN(STR$(max))
  498.     d|=0
  499.   ENDIF
  500.   FOR i|=10 DOWNTO 0
  501.     RSET ordinate$=STR$(min+(max-min)/10*(10-i|),z|,d|)
  502.     TEXT x%+3,y&+8+i|*8,ordinate$
  503.     LINE a_null&-5,y&+5+i|*8,a_null&,y&+5+i|*8
  504.   NEXT i|
  505.   '
  506.   LINE a_null&,o_null&,a_null&+schrittweite&*breite|,o_null&
  507.   IF breite|>4
  508.     FOR i%=von& TO bis&
  509.       LINE a_null&+i%*breite|,o_null&,a_null&+i%*breite|,o_null&+3
  510.     NEXT i%
  511.   ENDIF
  512.   TEXT a_null&+(bis&/2)*breite|-LEN(STR$(bis&/2))*4,o_null&+10,STR$(INT(bis&/2))
  513.   TEXT a_null&+bis&*breite|-LEN(STR$(bis&))*8,o_null&+10,STR$(bis&)
  514. RETURN
  515. '
  516. > PROCEDURE auswahl_box(menge_soll|,n|,VAR wahl$(),a!())
  517.   DIM a!(n|)
  518.   ARRAYFILL a!(),TRUE
  519.   ok!=FALSE
  520.   revers!=FALSE
  521.   markiert!=TRUE
  522.   ende!=FALSE
  523.   menge_ist|=0
  524.   DEFFILL 1
  525.   ma|=LEN(wahl$(1))
  526.   FOR i|=2 TO n|
  527.     ma|=MAX(ma|,LEN(wahl$(i|)))
  528.   NEXT i|
  529.   '
  530.   IF n|>10
  531.     l|=120
  532.   ELSE
  533.     l|=(n|*12)
  534.   ENDIF
  535.   b&=SUCC(INT(MAX((ma|*8)+30,156)/10))*10
  536.   x&=320-b&/2
  537.   y|=110-l|/2
  538.   GET x&,y|,x&+b&+1,y|+l|+37,hintergrund$
  539.   COLOR 0
  540.   PBOX x&,y|,x&+b&,y|+l|+36
  541.   COLOR 1
  542.   INC x&
  543.   INC y|
  544.   BOX x&,y|,x&+b&,y|+12
  545.   TEXT x&+b&/2-68,y|+9,"Bitte Wählen Sie!"
  546.   BOX x&,y|+12,x&+b&,y|+23
  547.   IF n|>10
  548.     FOR p&=x&+1 TO x&+b& STEP 10
  549.       LINE p&+1,y|+18,p&+5,y|+14
  550.       LINE p&+5,y|+14,p&+9,y|+18
  551.       LINE p&+2,y|+17,p&+2,y|+21
  552.       LINE p&+2,y|+21,p&+8,y|+21
  553.       LINE p&+8,y|+21,p&+8,y|+17
  554.     NEXT p&
  555.   ELSE
  556.     DEFFILL ,3
  557.     FILL x&+3,y|+15
  558.   ENDIF
  559.   BOX x&,y|+23,x&+b&,y|+23+l|
  560.   BOX x&,y|+23+l|,x&+b&,y|+34+l|
  561.   IF n|>10
  562.     FOR p&=x&+1 TO x&+b& STEP 10
  563.       LINE p&+1,y|+l|+5+23,p&+5,y|+l|+9+23
  564.       LINE p&+5,y|+l|+9+23,p&+9,y|+l|+5+23
  565.       LINE p&+2,y|+l|+1+23,p&+2,y|+l|+5+23
  566.       LINE p&+2,y|+l|+1+23,p&+8,y|+l|+1+23
  567.       LINE p&+8,y|+l|+1+23,p&+8,y|+l|+5+23
  568.     NEXT p&
  569.   ELSE
  570.     DEFFILL ,3
  571.     FILL x&+3,y|+25+l|
  572.   ENDIF
  573.   LINE x&+15,y|+23,x&+15,y|+23+l|
  574.   FOR i|=0 TO MIN(n|-1,9)
  575.     TEXT x&+3,y|+31+i|*12,i|
  576.   NEXT i|
  577.   DEC x&
  578.   DEC y|
  579.   BOX x&,y|,x&+b&,y|+l|+36
  580.   FOR l&=y|+23 TO y|+23+l| STEP 12
  581.     LINE x&,l&,x&+b&,l&
  582.   NEXT l&
  583.   FOR i|=1 TO MIN(n|,10)
  584.     TEXT x&+b&/2-(LEN(wahl$(i|))*8)/2,y|+20+i|*12,wahl$(i|)
  585.   NEXT i|
  586.   erster|=1
  587.   li&=x&+b&
  588.   l1|=y|+12
  589.   l2|=l1|+11
  590.   l3|=l2|+l|
  591.   l4|=l3|+11
  592.   REPEAT
  593.     taste$=INKEY$
  594.     IF taste$<>""
  595.       IF LEN(taste$)=1
  596.         taste&=ASC(taste$)
  597.       ELSE
  598.         taste&=ASC(RIGHT$(taste$))
  599.       ENDIF
  600.       SELECT taste&
  601.       CASE 65
  602.         IF erster|<n|-9
  603.           sel_rev(10)
  604.           sel_scr(1)
  605.         ENDIF
  606.       CASE 66
  607.         IF erster|>1
  608.           sel_rev(10)
  609.           sel_scr(0)
  610.         ENDIF
  611.       CASE 48 TO 57
  612.         SUB taste&,48
  613.         IF taste&<n|
  614.           IF a!(erster|+taste&)=TRUE
  615.             a!(erster|+taste&)=FALSE
  616.             INC menge_ist|
  617.             COLOR 1
  618.             LINE x&+b&-10,y|+30+taste&*12,x&+b&-7,y|+33+taste&*12
  619.             LINE x&+b&-7,y|+33+taste&*12,x&+b&-3,y|+25+taste&*12
  620.           ELSE
  621.             a!(erster|+taste&)=TRUE
  622.             DEC menge_ist|
  623.             COLOR 0
  624.             LINE x&+b&-10,y|+30+taste&*12,x&+b&-7,y|+33+taste&*12
  625.             LINE x&+b&-7,y|+33+taste&*12,x&+b&-3,y|+25+taste&*12
  626.           ENDIF
  627.         ENDIF
  628.       CASE 13
  629.         ende!=TRUE
  630.       ENDSELECT
  631.       taste$=""
  632.     ENDIF
  633.     IF MOUSEX>x& AND MOUSEX<li& AND MOUSEY>l2| AND MOUSEY<l3| AND MOUSEK<>2
  634.       '                           Mauszeiger im Auswahlfeld
  635.       eintrag|=MAX(0,(MOUSEY-y|-24)/12)
  636.       sel_rev(eintrag|)
  637.       IF MOUSEK=1 AND ok!=FALSE
  638.         IF a!(erster|+eintrag|)=TRUE
  639.           a!(erster|+eintrag|)=FALSE
  640.           INC menge_ist|
  641.           COLOR 1
  642.           LINE x&+b&-10,y|+30+eintrag|*12,x&+b&-7,y|+33+eintrag|*12
  643.           LINE x&+b&-7,y|+33+eintrag|*12,x&+b&-3,y|+25+eintrag|*12
  644.         ELSE
  645.           a!(erster|+eintrag|)=TRUE
  646.           DEC menge_ist|
  647.           COLOR 3
  648.           LINE x&+b&-10,y|+30+eintrag|*12,x&+b&-7,y|+33+eintrag|*12
  649.           LINE x&+b&-7,y|+33+eintrag|*12,x&+b&-3,y|+25+eintrag|*12
  650.         ENDIF
  651.       ENDIF
  652.       ok!=MOUSEK
  653.     ELSE
  654.       sel_rev(10)
  655.     ENDIF
  656.     IF MOUSEX>x& AND MOUSEX<li& AND MOUSEY>l1| AND MOUSEY<l2| AND MOUSEK=1 AND erster|<n|-9
  657.       '                           Mauszeiger im oberen Scrollfeld
  658.       sel_scr(1)
  659.     ELSE IF MOUSEX>x& AND MOUSEX<li& AND MOUSEY>l3| AND MOUSEY<l4| AND MOUSEK=1 AND erster|>1
  660.       '                           Mauszeiger im unteren Scrollfeld
  661.       sel_scr(0)
  662.     ENDIF
  663.   UNTIL MOUSEK=2 OR ende!=TRUE OR menge_soll|=menge_ist|
  664.   PUT x&,y|,hintergrund$
  665. RETURN
  666. > PROCEDURE sel_rev(nummer|)
  667.   IF revers!=TRUE AND revers|<>nummer|        !Revers off
  668.     GET x&+19,y|+25+revers|*12,x&+b&-3,y|+33+revers|*12,revers$
  669.     PUT x&+19,y|+25+revers|*12,revers$,30
  670.     revers!=FALSE
  671.   ELSE IF revers!=FALSE AND nummer|<10        !Revers on
  672.     GET x&+19,y|+25+nummer|*12,x&+b&-3,y|+33+nummer|*12,revers$
  673.     PUT x&+19,y|+25+nummer|*12,revers$,30
  674.     revers!=TRUE
  675.     revers|=nummer|
  676.   ENDIF
  677. RETURN
  678. > PROCEDURE sel_scr(richtung|)
  679.   IF richtung|
  680.     INC erster|
  681.   ELSE
  682.     DEC erster|
  683.   ENDIF
  684.   GET x&+17,y|+25+richtung|*12,x&+b&-1,y|+10+l|+richtung|*12,teil$
  685.   PUT x&+17,y|+37-richtung|*12,teil$
  686.   DEFFILL 0
  687.   PBOX x&+18,y|+25+richtung|*108,x&+b&-1,y|+34+richtung|*108
  688.   DEFFILL 1
  689.   TEXT x&+5+b&/2-(LEN(wahl$(erster|+richtung|*9))*8)/2,y|+32+richtung|*108,wahl$(erster|+richtung|*9)
  690.   IF a!(erster|+richtung|*9)=FALSE
  691.     COLOR 1
  692.     LINE x&+b&-10,y|+30+richtung|*108,x&+b&-7,y|+33+richtung|*108
  693.     LINE x&+b&-7,y|+33+richtung|*108,x&+b&-3,y|+25+richtung|*108
  694.   ENDIF
  695. RETURN
  696.